7  Appendix D

7.1 Setup

7.1.1 Install Packages

We install the following packages using the groundhog package manager to increase computational reproducibility.

options(repos = c(CRAN = "https://cran.r-project.org")) 

if (!requireNamespace("groundhog", quietly = TRUE)) {
    install.packages("groundhog")
}

pkgs <- c("magrittr", "data.table", "ggplot2", "ggsignif")

groundhog::groundhog.library(pkg = pkgs,
                             date = "2024-08-01")

rm(pkgs)

7.1.2 Read Data

data <- readRDS(file="../data/processed/full.Rda")

7.1.3 Design

We define some design features in the following:

colors <- c("#F3B05C", "#1E4A75", "#65B5C0", "#AD5E21")

layout <- theme(panel.background = element_rect(fill = "white"),
                legend.key = element_rect(fill = "white"),
                panel.grid.major.y = element_line(colour = "grey", 
                                                  linewidth = 0.25),
                axis.ticks.y = element_blank(),
                panel.grid.major.x = element_blank(),
                axis.line.x.bottom = element_line(colour = "#000000", 
                                                  linewidth = 0.5),
                axis.line.y.left = element_blank(),
                plot.title = element_text(size = rel(1))
)

7.2 Figure D.1

7.2.1 Panel a

wilcox_test <- wilcox.test(formula = credibility ~ surprise, 
                           data = data[treated == 1])

p_value <- wilcox_test$p.value
p_value_text <- ifelse(p_value < 0.01, "***", ifelse(p_value < 0.05, "**", ifelse(p_value < 0.10, "*", "ns")))
formatted_p_value <- format(x = p_value, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1],
       mapping = aes(y = credibility,
                     x = surprise)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = list(c("FALSE", "TRUE")),
              annotations = paste0(formatted_p_value, " (", p_value_text, ")"),
              y_position = 3.5,
              tip_length = 0,
              size = 0.5) +
  labs(x = "Contradiction",
       y = "Credibility") +
  layout

Figure 7.1: Credibility, confirmation compared to contradiction

7.2.2 Panel c

comparisons <- list(c("point", "interval"), 
                    c("point", "both"), 
                    c("interval", "both"))

p_values <- sapply(comparisons, function(comp) {
  test <- wilcox.test(formula = credibility ~ communication, 
                      data = data[treated == 1 & surprise == FALSE & communication %in% comp])
  test$p.value
})

p_values_text <- sapply(p_values, function(p) {
  ifelse(p < 0.01, "***", ifelse(p < 0.05, "**", ifelse(p < 0.10, "*", "ns")))
})

formatted_p_values <- format(x = p_values, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1 & surprise == FALSE],
       mapping = aes(y = credibility,
                     x = communication)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = comparisons,
              annotations = paste0(formatted_p_values, " (", p_values_text, ")"),
              y_position = c(3.0, 3.3, 3.6),
              tip_length = 0,
              size = 0.5) +
  labs(x = "Communication",
       y = "Credibility") +
  layout

Figure 7.2: Credibility, confirmation treatments

7.2.3 Panel e

comparisons <- list(c("point", "interval"), 
                    c("point", "both"), 
                    c("interval", "both"))

p_values <- sapply(comparisons, function(comp) {
  test <- wilcox.test(formula = credibility ~ communication, 
                      data = data[treated == 1 & surprise == TRUE & communication %in% comp])
  test$p.value
})

p_values_text <- sapply(p_values, function(p) {
  ifelse(p < 0.01, "***", ifelse(p < 0.05, "**", ifelse(p < 0.10, "*", "ns")))
})

formatted_p_values <- format(x = p_values, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1 & surprise == TRUE],
       mapping = aes(y = credibility,
                     x = communication)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = comparisons,
              annotations = paste0(formatted_p_values, " (", p_values_text, ")"),
              y_position = c(3.0, 3.3, 3.6),
              tip_length = 0,
              size = 0.5) +
  labs(x = "Communication",
       y = "Credibility") +
  layout

Figure 7.3: Credibility, contradiction treatments

7.2.4 Panel b

ggplot(data = data[treated == 1],
       mapping = aes(x = credibility, fill = surprise)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Credibility",
       y = "Density") +
  layout

Figure 7.4: Credibility, confirmation compared to contradiction (density)

7.2.5 Panel d

ggplot(data = data[treated == 1 & surprise == FALSE],
       mapping = aes(x = credibility, fill = communication)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Credibility",
       y = "Density") +
  layout

Figure 7.5: Credibility, confirmation treatments (density)

7.2.6 Panel f

ggplot(data = data[treated == 1 & surprise == TRUE],
       mapping = aes(x = credibility, fill = communication)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Credibility",
       y = "Density") +
  layout

Figure 7.6: Credibility, contradiction treatments

7.3 Figure D.2

7.3.1 Panel a

wilcox_test <- wilcox.test(formula = accuracy ~ surprise, 
                           data = data[treated == 1])

p_value <- wilcox_test$p.value
p_value_text <- ifelse(p_value < 0.01, "***", ifelse(p_value < 0.05, "**", ifelse(p_value < 0.10, "*", "ns")))
formatted_p_value <- format(x = p_value, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1],
       mapping = aes(y = accuracy,
                     x = surprise)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = list(c("FALSE", "TRUE")),
              annotations = paste0(formatted_p_value, " (", p_value_text, ")"),
              y_position = 3.5,
              tip_length = 0,
              size = 0.5) +
  labs(x = "Contradiction",
       y = "Accuracy") +
  layout

Figure 7.7: Accuracy, confirmation compared to contradiction

7.3.2 Panel c

comparisons <- list(c("point", "interval"), 
                    c("point", "both"), 
                    c("interval", "both"))

p_values <- sapply(comparisons, function(comp) {
  test <- wilcox.test(formula = accuracy ~ communication, 
                      data = data[treated == 1 & surprise == FALSE & communication %in% comp])
  test$p.value
})

p_values_text <- sapply(p_values, function(p) {
  ifelse(p < 0.01, "***", ifelse(p < 0.05, "**", ifelse(p < 0.10, "*", "ns")))
})

formatted_p_values <- format(x = p_values, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1 & surprise == FALSE],
       mapping = aes(y = accuracy,
                     x = communication)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = comparisons,
              annotations = paste0(formatted_p_values, " (", p_values_text, ")"),
              y_position = c(3.0, 3.3, 3.6),
              tip_length = 0,
              size = 0.5) +
  labs(x = "Communication",
       y = "Accuracy") +
  layout

Figure 7.8: Accuracy, confirmation treatments

7.3.3 Panel e

comparisons <- list(c("point", "interval"), 
                    c("point", "both"), 
                    c("interval", "both"))

p_values <- sapply(comparisons, function(comp) {
  test <- wilcox.test(formula = accuracy ~ communication, 
                      data = data[treated == 1 & surprise == TRUE & communication %in% comp])
  test$p.value
})

p_values_text <- sapply(p_values, function(p) {
  ifelse(p < 0.01, "***", ifelse(p < 0.05, "**", ifelse(p < 0.10, "*", "ns")))
})

formatted_p_values <- format(x = p_values, digits = 3, scientific = TRUE)

ggplot(data = data[treated == 1 & surprise == TRUE],
       mapping = aes(y = accuracy,
                     x = communication)) +
  geom_bar(stat = "summary", 
           fun = mean,
           fill = colors[2]) +
  scale_y_continuous(limits = c(0, 4),
                     expand = c(0, NA)) +
  geom_signif(comparisons = comparisons,
              annotations = paste0(formatted_p_values, " (", p_values_text, ")"),
              y_position = c(3.0, 3.3, 3.6),
              tip_length = 0,
              size = 0.5) +
  labs(x = "Communication",
       y = "Accuracy") +
  layout

Figure 7.9: Accuracy, contradiction treatments

7.3.4 Panel b

ggplot(data = data[treated == 1],
       mapping = aes(x = accuracy, fill = surprise)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Accuracy",
       y = "Density") +
  layout

Figure 7.10: Accuracy, confirmation compared to contradiction (density)

7.3.5 Panel d

ggplot(data = data[treated == 1 & surprise == FALSE],
       mapping = aes(x = accuracy, fill = communication)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Accuracy",
       y = "Density") +
  layout

Figure 7.11: Accuracy, confirmation treatments (density)

7.3.6 Panel f

ggplot(data = data[treated == 1 & surprise == TRUE],
       mapping = aes(x = accuracy, fill = communication)) +
  geom_histogram(aes(y = after_stat(density)), 
                 alpha = 0.66,
                 position = "identity", 
                 binwidth = 1, 
                 color = "black") +
  scale_y_continuous(limits = c(0, 0.5),
                     expand = c(0, NA)) +
  labs(x = "Accuracy",
       y = "Density") +
  layout

Figure 7.12: Accuracy, contradiction treatments

Session Info

sessionInfo()

R version 4.4.1 (2024-06-14)
Platform: x86_64-apple-darwin20
Running under: macOS Sonoma 14.4.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: Europe/Zurich
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] ggsignif_0.6.4    ggplot2_3.5.1     data.table_1.15.4 magrittr_2.0.3   

loaded via a namespace (and not attached):
 [1] vctrs_0.6.5       cli_3.6.3         knitr_1.48        rlang_1.1.4      
 [5] xfun_0.46         generics_0.1.3    jsonlite_1.8.8    labeling_0.4.3   
 [9] glue_1.7.0        colorspace_2.1-1  htmltools_0.5.8.1 fansi_1.0.6      
[13] scales_1.3.0      rmarkdown_2.27    grid_4.4.1        evaluate_0.24.0  
[17] munsell_0.5.1     tibble_3.2.1      fastmap_1.2.0     yaml_2.3.10      
[21] lifecycle_1.0.4   compiler_4.4.1    dplyr_1.1.4       pkgconfig_2.0.3  
[25] htmlwidgets_1.6.4 rstudioapi_0.16.0 farver_2.1.2      digest_0.6.36    
[29] groundhog_3.2.0   R6_2.5.1          tidyselect_1.2.1  utf8_1.2.4       
[33] pillar_1.9.0      parallel_4.4.1    withr_3.0.1       tools_4.4.1      
[37] gtable_0.3.5